Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Jan/di9801rs/Sorter.pas

Pascal/Delphi Source File | 1997-08-20 | 5.6 KB | 227 lines

unit Sorter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ExtCtrls,
  SortAlgs;

type
  TSortForm = class(TForm)
    Label3: TLabel;
    NumRepsText: TEdit;
    AlgorithmGroup: TRadioGroup;
    Label5: TLabel;
    Panel1: TPanel;
    TimeLabel: TLabel;
    CmdSort: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    MaxValueText: TEdit;
    NumItemsText: TEdit;
    SortedCheck: TCheckBox;
    NumUnsortedText: TEdit;
    CmdBuildList: TButton;
    procedure CmdSortClick(Sender: TObject);
    procedure CmdBuildListClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SortItems;
    procedure CheckSort;
    procedure DisableCmdSort(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
    SortForm: TSortForm;

implementation

{$R *.DFM}
const
    AlgBubbleSort    = 0;
    AlgSelectionSort = 1;
    AlgQuicksort     = 2;
    AlgCountingsort  = 3;

type
    ValueType = Longint; // Type used in the arrays.
    IndexType = Longint; // Type used to index arrays.
    TValueArray = array[0..100000000] of ValueType;
    PValueArray = ^TValueArray;

var
    List, SortedList                : PValueArray;
    NumItems, MaxValue, NumUnsorted : IndexType;

// Sort the list items.
procedure TSortForm.SortItems;
var
    start_time, stop_time, ellapsed_time : TDateTime;
    i                                    : IndexType;
    num_reps, rep                        : Integer;
    hr, min, sec, msec                   : Word;
    secs                                 : Double;
begin
    TimeLabel.Caption := '';

    // See how many repetitions to perform.
    try
        num_reps := StrToInt(NumRepsText.Text);
    except
        NumRepsText.Text := '1';
        num_reps := 1;
    end;

    ellapsed_time := 0;
    for rep := 1 to num_reps do
    begin
        // Copy the list into the SortedList array.
        for i := 1 to NumItems do
        begin
            SortedList^[i] := List^[i];
        end;

        start_time := Time;
        case AlgorithmGroup.ItemIndex of
            AlgBubbleSort:    Bubblesort(SortedList^, 1, NumItems);
            AlgSelectionSort: Selectionsort(SortedList^, 1, NumItems);
            AlgQuicksort:     Quicksort(SortedList^, 1, NumItems);
            AlgCountingsort:  Countingsort(List^, SortedList^, 1, NumItems, 1, MaxValue);
        end;
        stop_time := Time;
        ellapsed_time :=
            ellapsed_time + stop_time - start_time;
    end;    // for rep := 1 to num_reps do

    DecodeTime(ellapsed_time, hr, min, sec, msec);
    secs := sec + msec / 1000;
    TimeLabel.Caption := Format('%.2f', [secs]);
end;

// Verify the sort's correctness.
procedure TSortForm.CheckSort;
var
    i : IndexType;
begin

    for i := 2 to NumItems do
    begin
        if (SortedList^[i - 1] > SortedList^[i]) Then
        begin
            Beep;
            ShowMessage(Format(
                'SortedList[%d] = %d, SortedList[%d] = %d',
                [i - 1, SortedList^[i - 1],
                 i, SortedList^[i]]));
            Exit;
        end;
    end;
end;

procedure TSortForm.CmdSortClick(Sender: TObject);
begin
    // Display the hourglass cursor.
    Screen.Cursor := crHourGlass;

    // Sort the list.
    SortItems;

    // Verify the sort's correctness.
    CheckSort;

    // Remove the hourglass cursor.
    Screen.Cursor := crDefault;
end;

procedure TSortForm.CmdBuildListClick(Sender: TObject);
var
    i, j, k : IndexType;
    temp    : ValueType;
begin
    // Display the hourglass cursor.
    Screen.Cursor := crHourGlass;

    // Read the test parameters.
    try
        NumItems := StrToInt(NumItemsText.Text);
    except
        NumItemsText.Text := '1000';
        NumItems := 1000;
    end;
    try
        MaxValue := StrToInt(MaxValueText.Text);
    except
        MaxValueText.Text := '10000';
        MaxValue := 10000;
    end;

    if (SortedCheck.Checked) then
    begin
        try
            NumUnsorted := StrToInt(NumUnsortedText.Text);
        except
            NumUnsortedText.Text := '1';
            NumUnsorted := 1;
        end;
    end;

    // Free previously allocated memory.
    FreeMem(List);
    FreeMem(SortedList);

    // Allocate room for the lists.
    GetMem(List, (NumItems + 1) * SizeOf(ValueType));
    GetMem(SortedList, (NumItems + 1) * SizeOf(ValueType));

    // Initialize the list randomly.
    for i := 1 to NumItems do
        List^[i] := Trunc(Random(MaxValue)) + 1;

    // Sort the list if necessary.
    if (SortedCheck.Checked) then
    begin
        // Sort the list.
        Quicksort(List^, 1, NumItems);

        // Swap items to put NumUnsorted
        // items out of order.
        for i := 1 to NumUnsorted Div 2 do
        begin
            j := Trunc(Random(NumItems)) + 1;
            k := Trunc(Random(NumItems)) + 1;
            temp := List^[j];
            List^[j] := List^[k];
            List^[k] := temp;
        end;
    end;

    // Enable the Sort button.
    CmdSort.Enabled := True;

    // Remove the hourglass cursor.
    Screen.Cursor := crDefault;
end;

procedure TSortForm.FormCreate(Sender: TObject);
begin
    Randomize;

    // Allocate some space to free later.
    GetMem(List, SizeOf(ValueType));
    GetMem(SortedList, SizeOf(ValueType));
end;

procedure TSortForm.DisableCmdSort(Sender: TObject);
begin
   CmdSort.Enabled := False;
end;


end.